--- A non-empty list
package frege.data.NonEmpty where

import frege.prelude.PreludeBase public (NonEmpty)
import frege.Prelude hiding (reverse, scanl, scanl1, scanr, scanr1, iterate, cycle, zip, unzip)

import frege.data.List () 

import Data.Monoid (Semigroup)
import Data.Foldable (Foldable)
import Data.Traversable (Traversable)

derive Eq   (NonEmpty a)
derive Ord  (NonEmpty a)

infixr 6 `:|` `<|`

instance ListSemigroup NonEmpty where
  (NonEmpty a b) ++ (NonEmpty c d) = NonEmpty a (b ++ [c] ++ d)

instance ListSource NonEmpty where
  toList (NonEmpty h t) = h : t
  
instance Functor NonEmpty where
  fmap f (NonEmpty h t) = NonEmpty (f h) (fmap f t) 

instance Monad NonEmpty where
  pure x = NonEmpty x []
  (NonEmpty h t) >>= f = let NonEmpty a b = f h
                             k = t >>= (toList . f)
                         in NonEmpty a (b ++ k)

instance Semigroup (NonEmpty a) where
 mappend xs ys = xs ++ ys
   
instance Foldable NonEmpty where
  foldr f x (NonEmpty h t) = Prelude.foldr f x (h:t)
  foldl f x (NonEmpty h t) = Prelude.fold  f x (h:t)
       
instance Traversable NonEmpty where
  traverse f list = liftA2 nonEmpty (f list.neHead) (traverse f list.neTail)
                                                      
instance Show a => Show (NonEmpty a) where
  show (NonEmpty h t) = concat ["|",show h, showT t, "|"] where
     showT [] = ""
     showT (x:xs) = "," ++ show x ++ showT xs 

--- Constructs a non-empty list with the given head and tail.
nonEmpty :: a -> [a] -> NonEmpty a
nonEmpty x xs = NonEmpty x xs

--- Constructs a non-empty list with the given head and tail (an alias for 'nonEmpty').
(:|) :: a -> [a] -> NonEmpty a
x :| xs = nonEmpty x xs

--- Tries to convert a list to a 'NonEmpty' returning 'Nothing' if the given list is empty.
toNonEmpty :: [a] -> Maybe (NonEmpty a)
toNonEmpty (h:t) = Just (NonEmpty h t)
toNonEmpty _ = Nothing

--- Converts a list to a 'NonEmpty' using the given default value for the empty list case.
toNonEmpty' :: NonEmpty a -> [a] -> NonEmpty a
toNonEmpty' _ (x:xs) = NonEmpty x xs
toNonEmpty' deflt  _ = deflt

--- _WARNING: Fails if given the empty list._
--- Tries to convert a list to a 'NonEmpty'.
unsafeToNonEmpty :: [a] -> NonEmpty a
unsafeToNonEmpty xs = toNonEmpty' (error "unsafeToNonEmpty on empty list") xs

--- Prepends a value to a 'NonEmpty'.
(<|) :: a -> NonEmpty a -> NonEmpty a
a <| NonEmpty h t = NonEmpty a (h:t)

---Number of elements in NonEmpty list.
protected length :: NonEmpty a -> Int
protected length (NonEmpty _ tail) = 1 + Prelude.length tail
 
--- Reverses the elements of the (finite) 'NonEmpty'.
protected reverse :: NonEmpty a -> NonEmpty a
protected reverse ne = lift Prelude.reverse ne

--- scanl is similar to foldl, but returns a 'NonEmpty' of successive reduced values from the left
protected scanl :: (b -> a -> b) -> b -> NonEmpty a -> NonEmpty b
protected scanl f z ne = lift (Prelude.scanl f z) ne

--- scanl1 is similar to foldl1, but returns a 'NonEmpty' of successive reduced values from the left
protected scanl1 :: (a -> a -> a) -> NonEmpty a -> NonEmpty a
protected scanl1 f ne = lift (Prelude.scanl1 f) ne

--- scanr is similar to foldr, but returns a 'NonEmpty' of successive reduced values from the right
protected scanr :: (a -> b -> b) -> b -> NonEmpty a -> NonEmpty b
protected scanr f z ne = lift (Prelude.scanr f z) ne

--- scanr1 is similar to foldr1, but returns a 'NonEmpty' of successive reduced values from the right
protected scanr1 :: (a -> a -> a) -> NonEmpty a -> NonEmpty a
protected scanr1 f ne = lift (Prelude.scanr1 f) ne

--- iterate f x returns an infinite 'NonEmpty' of repeated applications of f to x
protected iterate :: (a -> a) -> a -> NonEmpty a
protected iterate f start = start :| Prelude.iterate f (f start)

{-- cycle ties a finite 'NonEmpty' into a circular one, or equivalently, the infinite repetition
    of the original 'NonEmpty'. It is the identity on infinite 'NonEmpty's. 
    -}
protected cycle :: (ListSource src) => src a -> NonEmpty a
protected cycle ne = lift Prelude.cycle ne

--- The inits function returns all initial segments of the argument, shortest first.
protected inits :: NonEmpty a -> [NonEmpty a]
protected inits (NonEmpty h t) = Prelude.map (NonEmpty h) (List.inits t)

--- The tails function returns all final segments of the argument, longest first.
protected tails :: NonEmpty a -> [NonEmpty a]
protected tails (NonEmpty h t) = Prelude.map (unsafeToNonEmpty) (init $ List.tails (h:t))

--- The sort function implements a stable sorting algorithm.
protected sort :: (Ord a) => NonEmpty a -> NonEmpty a
protected sort ne = lift List.sort ne

{-- The insert function takes an element and a 'NonEmpty' and inserts the element 
    into the 'NonEmpty' at the last position where it is still less than or equal to the next element.
    -}
protected insert :: (Ord a) => a -> NonEmpty a -> NonEmpty a
protected insert a ne = lift (List.insert a) ne

--- unzip transforms a 'NonEmpty' of pairs into a 'NonEmpty' of first components and a 'NonEmpty' of second components. 
protected unzip :: NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)
protected unzip xs = (fmap fst xs, fmap snd xs)
                     
{-- zip takes two 'NonEmpty's and returns a 'NonEmpty' of corresponding pairs.
    If one input 'NonEmpty's is short, excess elements of the longer 'NonEmpty' are discarded. 
    -}
protected zip :: NonEmpty a -> NonEmpty b -> NonEmpty (a,b)
protected zip (NonEmpty x xs) (NonEmpty y ys) = NonEmpty (x,y) $ Prelude.zip xs ys

-- ---------------
-- Not exported --
-- ---------------

private lift :: ListSource src => ([a] -> [b]) -> src a -> NonEmpty b
private lift f xs = unsafeToNonEmpty $ f $ toList xs
